#!/usr/bin/perl
# 役判定テスト

use strict;
use warnings;

local $\ = "\n";

# （参考）
# 麻雀の役一覧 - Wikipedia
# http://ja.wikipedia.org/wiki/麻雀の役一覧

# アルファベット順でm<p<s <z になるようにする。
# m,p,s の順は良いが zは必ず最後になるようにしておく。
# ソートに m,s,p < z 必須

# m  : 萬子
# s  : 索子
# p  : 筒子

# z1 : 東
# z2 : 南
# z3 : 西
# z4 : 北
# z5 : 白
# z6 : 發
# z7 : 中

my %test_data = (

	test1 => {
		search_target => "m2m3m3m4m4m5m5m5m5m6m6m6m6m7",
		head_hai => 0, # m5
		tsumo    => 'm2',
		# ポン、チー、カンは？
		foo_ro   => 0, # 副露（フーロ）
		dora     => 0, # ドラ数
		ippatsu  => 0, # 一発（いっぱつ）
		reach    => 1, # 立直（リーチ）or 黙聴（ダマテン）
		own_home => 'E',# 自風
		now_home => 'E',# 場風
		double_reach => 0, # ダブルリーチ
		agari_hai    => 'm2', # 上がり牌（決め手の牌）
		
		# 上がり役定義
		YAKU => ['TANYAO'],
	},

	test2 => {
		search_target => "m1m2m3s1s2s3p1p2p3p9p9z1z1z1",
		head_hai => 0, # p9
		agari_hai    => 'm1', # 上がり牌（決め手の牌）
		
		# 上がり役定義
		YAKU => [],
	},

	test3 => {
		# ダディクールのタンヤオ -> 四暗刻が判定できるか？
		search_target => "m2m3m4m2m3m4m2m3m4p2p2p2m5m5",
		head_hai => 0, # p9
		agari_hai    => 'm2',
		
		# 上がり役定義
		YAKU => ['TANYAO'],
	},
	
	test4 => {
		# 平和、タンヤオ、四暗刻、
		search_target => "m2m3m4m2m3m4m2m3m4p2p3p4m5m5",
		head_hai => 0, # p9
		agari_hai    => 'm2',
		
		# 上がり役定義
		YAKU => ['TANYAO', 'PINHU'],
	},
	test5 => {
		# 平和とみせかけてカンチャン待ち
		search_target => "m1m2m2m3m3m4m4m5m6m7m8m9m5m5",
		head_hai => 0, # p9
		agari_hai    => 'm2',
		
		# 上がり役定義
		YAKU => [],
	},
);

MAIN: {
	
	#while (my ($test_type, $hash) = each %test) {
	foreach my $test_type (sort keys %test_data) {
		
		my %param = (
			target    => $test_data{$test_type}->{search_target},
			agari_hai => $test_data{$test_type}->{agari_hai},
		);
		
		print "-- label $test_type";
		print "-- search $test_data{$test_type}->{search_target} $test_data{$test_type}->{agari_hai}";
		
		my ($rc, %result) = hantei(\%param);
		if ($rc) {
			if (exists $test_data{$test_type}->{YAKU}) {
				my $src_list = $test_data{$test_type}->{YAKU};
				my $tgt_list = $result{YAKU};
				
				print "src @$src_list";
				print "tgt @$tgt_list";
				
			}
		}
	}
}

sub hantei
{
	my ($param) = @_;
	my %result;
	my $rc = 0;
	my @yakulist;
	
	# 引数初期化
	my $tgt        = $param->{target};    # 必須
	my $agari_hai = $param->{agari_hai}; # 必須
	
	
	
	# 役判定
	# 七対子（チートイツ）判定
	# 国士無双（コクシムソウ）判定
	# 
	
	# 刻子、順子優先それぞれ評価
	my ($c_rc, @c_mentsu) = hantei_cous($tgt);
	my ($j_rc, @j_mentsu) = hantei_juns($tgt);
	
	if ( $c_rc or $j_rc ) {
		
		# 上がり判定成功
		#   役なければ 0 にする？
		$rc = 1;
		
		# 組み合わせができている
		if ($c_rc) {
			foreach my $line ( @c_mentsu ) {
#					print $line;
			}
		}
		if ($j_rc) {
			foreach my $line ( @c_mentsu ) {
#					print $line;
			}
		}
		
		# <役判定>
		#    一翻
		# 立直（リーチ）
		# 一発（いっぱつ）
		# 門前清自摸和（メンゼンチンツモホウ）
		# 断么九（タンヤオチュー）
		if ( is_tanyao(\@j_mentsu) ) {
			push @yakulist, "TANYAO"
		}
		
		# 平和（ピンフ）
		if ( is_pinhu(\@j_mentsu, $agari_hai) ) {
			
			# 鳴いていたら取り消し
			
			
			push @yakulist, "PINHU";
		}
		# 一盃口（イーペーコー）
		# 自風牌
		# 場風牌
		# 白
		# 發
		# 中
		# 嶺上開花（リンシャンカイホウ）
		# 槍槓（チャンカン）
		# 海底摸月（ハイテイモーユエ）
		# 河底撈魚（ホーテイラオユイ）
		# 
		#    二翻
		# 三色同順 	サンショクドウジュン
		# 一気通貫（イッキツウカン）
		# 混全帯么九 	ホンチャンタイヤオチュー
		# 七対子 	チートイツ
		# 対々和 	トイトイホー
		# 三暗刻 	サンアンコー
		# 混老頭 	ホンロウトー
		# 三色同刻 	サンショクドーコー
		# 三槓子 	サンカンツ
		# 小三元 	ショウサンゲン
		# ダブル立直 	ダブルリーチ
		#
		#    三翻
		# 混一色 	ホンイーソー
		# 純全帯么九 	ジュンチャンタイヤオチュー
		# 二盃口 	リャンペーコー
		#
		#    六飜
		# 清一色 	チンイーソー
		#
		#    役満
		# 国士無双 	コクシムソウ
		# 四暗刻（スーアンコー）
		# if (is_suanko() ) {
		#	
		#	# ロンなら四暗刻にならない。
		#}
		# 大三元 	ダイサンゲン
		# 字一色 	ツーイーソー
		# 小四喜 	ショウスーシー
		# 大四喜 	ダイスーシー
		# 緑一色 	リューイーソー
		# 清老頭 	チンロートー
		# 四槓子 	スーカンツ
		# 九蓮宝燈 	チューレンポウトー
		# 天和 	テンホウ
		# 地和 	チーホウ
		
	}
	
	$result{YAKU} = \@yakulist;
	
	return ($rc, %result);
}

# ---------------------------------
# 組み合わせができているかチェック
#  牌が整形ソートされていること必須
#  刻子優先モード
# ---------------------------------
sub hantei_cous
{
	my ($search_target, $head_hai) = @_;
	
	# 実行速度向上のため正規表現止めたほうがいい？
	my %hash;
	foreach my $hai ( $search_target =~ /\w\d/g ) {
		
		if (exists $hash{$hai}) {
			$hash{$hai}++;
		}
		else{ 
			$hash{$hai}=1;
		}
	}
	
	# 頭候補さがし
	my @heads;
	if ($head_hai) {
		# 頭確定
		push @heads, $head_hai;
	}
	else{
		while (my($k, $v) = each %hash) {
#			print "$k=$v";
			if ($v >= 2) {
				push @heads, $k;
#				print "may head $k";
			}
		}
	}
	
#	print "> hantei start";
	my @mentsu;
	my $rc;
	foreach my $head ( @heads ) {
#		print "-- head $head";
		my %s_hash = %hash;
		$s_hash{$head} -= 2;
		delete $s_hash{$head} if ($s_hash{$head} == 0);
		
		# 初期化
		@mentsu = ("$head,$head");
		
		# 刻子判定（刻子優先）
		while (my ($k, $v) = each %s_hash) {
			if ($v >= 3) {
				$s_hash{$k} -= 3;
				delete $s_hash{$k} if ($s_hash{$k} == 0);
#				print "COT $k $k $k";
				push @mentsu, "$k,$k,$k";
			}
		}
		
		# 順子判定
		# s_hash にキーが無くなれば成功
		my $success = 1;
		while (keys %s_hash != 0) {
			
			# 順子を作る一番若いのを取得
			my ($first) = sort keys %s_hash;
			my ($type, $num) = split //, $first;
			my $second = $type . ($num + 1);
			my $third  = $type . ($num + 2);
			
			# 字牌は順子にならない
			if ($type eq 'z') {
				$success = 0;
				last;
			}
			
			if (exists $s_hash{$second} && exists $s_hash{$third}) {
#				print "JUN $first $second $third";
				$s_hash{$first}  -= 1;
				$s_hash{$second} -= 1;
				$s_hash{$third}  -= 1;
				
				delete $s_hash{$first}  if $s_hash{$first}  == 0;
				delete $s_hash{$second} if $s_hash{$second} == 0;
				delete $s_hash{$third}  if $s_hash{$third}  == 0;
				
				push @mentsu, "$first,$second,$third";
			}
			else{
				# faild
				$success = 0;
				last;
			}
		}
		
		if ($success == 1) {
#			print "ok!";
			$rc = 1;
			last;
		}
		else{
#			print "faild";
		}
		
	}
	
	return ($rc, @mentsu);
}
# ---------------------------------
# 組み合わせができているかチェック
#  牌が整形ソートされていること必須
#  順子優先モード
# ---------------------------------
sub hantei_juns
{
	my ($search_target, $head_hai) = @_;
	
	# 実行速度向上のため正規表現止めたほうがいい？
	my %hash;
	foreach my $hai ( $search_target =~ /\w\d/g ) {
		
		if (exists $hash{$hai}) {
			$hash{$hai}++;
		}
		else{ 
			$hash{$hai}=1;
		}
	}
	
	# 頭候補さがし
	my @heads;
	if ($head_hai) {
		# 頭確定
		push @heads, $head_hai;
	}
	else{
		while (my($k, $v) = each %hash) {
#			print "$k=$v";
			if ($v >= 2) {
				push @heads, $k;
#				print "may head $k";
			}
		}
	}
	
#	print "> hantei start";
	my @mentsu;
	my $rc;
	foreach my $head ( @heads ) {
#		print "-- head $head";
		my %s_hash = %hash;
		$s_hash{$head} -= 2;
		delete $s_hash{$head} if ($s_hash{$head} == 0);
		
		# 初期化
		@mentsu = ("$head,$head");
		
		# 順子判定（順子優先）
		while (keys %s_hash != 0) {
			
			# 順子を作る一番若いのを取得 ソートに m,s,p < z 必須
			my ($first) = sort keys %s_hash;
			
			my ($type, $num) = split //, $first;
			my $second = $type . ($num + 1);
			my $third  = $type . ($num + 2);
			
			# 字牌は順子にならない
			if ($type eq 'z') {
				last;
			}
			
			if (exists $s_hash{$second} && exists $s_hash{$third}) {
#				print "JUN $first $second $third";
				$s_hash{$first}  -= 1;
				$s_hash{$second} -= 1;
				$s_hash{$third}  -= 1;
				
				delete $s_hash{$first}  if $s_hash{$first}  == 0;
				delete $s_hash{$second} if $s_hash{$second} == 0;
				delete $s_hash{$third}  if $s_hash{$third}  == 0;
				
				push @mentsu, "$first,$second,$third";
			}
			else{
				# faild
				last;
			}
		}
		
		# 刻子判定
		while (my ($k, $v) = each %s_hash) {
			if ($v >= 3) {
				$s_hash{$k} -= 3;
				delete $s_hash{$k} if ($s_hash{$k} == 0);
#				print "COT $k $k $k";
				push @mentsu, "$k,$k,$k";
			}
		}
		
		if (keys %s_hash == 0) {
			$rc = 1;
			last;
		}
	}
	
	return ($rc, @mentsu);
}


# 平和
# 
sub is_pinhu
{
	my ($mentsu, $agari_hai) = @_;
	my $rc = 1;
	
	foreach my $line ( @$mentsu ) {
		my ($first, $second, $third) = split /\,/, $line;
		unless (defined $third) {
			# 頭が上がり牌は成立しない
			if ($agari_hai eq $first) {
				$rc = 0;
				last;
			}
			next;
		}
		
		# 刻子は成立しない
		if ($first eq $second) {
			$rc = 0;
			last;
		}
		
		# 字牌は成立しない
		if ($line =~ /z/) {
			$rc = 0;
			last;
		}
		
		# 両面待ちしかダメ
		if ($second eq $agari_hai) {
			$rc = 0;
			last;
		}
		
	}
	return $rc;
}

# タンヤオ
sub is_tanyao
{
	my ($mentsu) = @_;
	my $rc=1;
	
	foreach my $line ( @$mentsu ) {
		$rc = 0 if ($line =~ /1|9|z/);
	}
	
	return $rc;
}
